
Imports System.IO
Imports std

Public Class configParser
    ' leave this changeable, so if necessary, can set a different kind of configuration
    Public escapeRemark As String = character.rightSlash
    Public remark As String = character.semicolon
    Public sectionLeft As String = character.leftMidBracket
    Public sectionRight As String = character.rightMidBracket
    Public separator As String = character.equalSign
    Public environmentMark As String = character.dollar
    Public filterMark As String = character.andMark
    Public filterKeyValueSep As String = character.colon
    Public featureNameSep As String = character.colon
    Public featureFilterSep As String = character.comma + character.sheffer

    Public curenv As [set](Of String) = Nothing
    Private data As map(Of String, map(Of String, list(Of pair(Of map(Of String, String), String)))) = Nothing
    Private _configfile As String = Nothing

    Public Function configfile() As String
        Return _configfile
    End Function

    Private Class featureNaming
        Public Const stringfilter As String = "stringfilter"
        Public Const valueinterval As String = "valueinterval"
        Public Const stringserial As String = "stringserial"
        Public Const environment As String = "env"
    End Class

    Private Class featuresDef
        Public stringFilter As [set](Of String) = Nothing
        Public valueInterval As [set](Of String) = Nothing
        Public stringSerial As [set](Of String) = Nothing

        Public Function stringFilterEnabled(ByVal filterName As String) As Boolean
            If stringFilter Is Nothing Then
                Return False
            Else
                Return stringFilter.find(filterName) <> stringFilter.end()
            End If
        End Function

        Public Function valueIntervalEnabled(ByVal filterName As String) As Boolean
            If valueInterval Is Nothing Then
                Return False
            Else
                Return valueInterval.find(filterName) <> valueInterval.end()
            End If
        End Function

        Public Function stringSerialEnabled(ByVal filterName As String) As Boolean
            If stringSerial Is Nothing Then
                Return False
            Else
                Return stringSerial.find(filterName) <> stringSerial.end()
            End If
        End Function
    End Class

    Private features As featuresDef = Nothing

    Private Delegate Function matchSingle(ByVal match As String, ByVal cur As String) As Boolean

    Private Shared Function matchStringFilter(ByVal match As String, ByVal cur As String) As Boolean
        Return fitfilter(match, cur, False)
    End Function

    Private Shared Function matchValueInterval(ByVal match As String, ByVal cur As String) As Boolean
        Return valueInterval.match(cur, match)
    End Function

    Private Shared Function matchStringSerial(ByVal match As String, ByVal cur As String) As Boolean
        Return stringSerial.match(cur, match)
    End Function

    Private Shared Function environmentMatchImpl(ByVal match As String, ByVal curenv As [set](Of String), _
                                                 ByVal matchcall As matchSingle) As Boolean
        assert(Not matchcall Is Nothing, "matchcall is nothing.")
        assert(Not curenv Is Nothing, "curenv is nothing.")

        Dim j As [set](Of String).iterator = Nothing
        j = curenv.begin()
        While j <> curenv.end()
            If matchcall(match, (+j)) Then
                Exit While
            End If
            j += 1
        End While

        Return (j <> curenv.end())
    End Function

    Private Function environmentMatch(ByVal matchenv As [set](Of String)) As Boolean
        If curenv Is Nothing OrElse curenv.size = 0 Then
            If matchenv Is Nothing OrElse matchenv.size = 0 Then
                Return True
            End If
            Return False
        End If

        Dim i As [set](Of String).iterator = Nothing
        i = matchenv.begin()
        While i <> matchenv.end()
            Dim rtn As Boolean = False
            If features.stringFilterEnabled(featureNaming.environment) Then
                rtn = environmentMatchImpl((+i), curenv, AddressOf matchStringFilter)
            End If
            If Not rtn AndAlso features.valueIntervalEnabled(featureNaming.environment) Then
                rtn = environmentMatchImpl((+i), curenv, AddressOf matchValueInterval)
            End If
            If Not rtn AndAlso features.stringSerialEnabled(featureNaming.environment) Then
                rtn = environmentMatchImpl((+i), curenv, AddressOf matchStringSerial)
            End If
            If Not rtn Then
                rtn = (curenv.find((+i).ToLower()) <> curenv.end())
            End If

            If Not rtn Then
                Return False
            End If
            i += 1
        End While

        Return True
    End Function

    Private Shared Function separateEnvironments(ByRef key As String _
                                                 , ByRef environments As [set](Of String) _
                                                 , ByVal environmentMark As String) As Boolean
        If isemptystring(environmentMark) Then
            Return True
        End If

        If environments Is Nothing Then
            environments = New [set](Of String)
        Else
            environments.clear()
        End If

        Dim envs As vector(Of String) = Nothing
        strsepar(key, environmentMark, envs, True)
        If envs.size() > 0 Then
            Dim i As Int64
            For i = 0 To envs.size() - 2
                environments.insert(envs(i).ToLower())
            Next
            key = envs(i)

            Return Not isemptystring(key)
        Else
            raiseError("caught an empty line " + key, errorHandle.errorType.warning)
            Return False
        End If
    End Function

    Private Shared Function separateFilter(ByVal keyValue As String _
                                           , ByVal filters As map(Of String, String) _
                                           , ByVal filterKeyValueSep As String) As Boolean
        assert(Not filters Is Nothing, "filters is a nothing map(of string,string) instance.")

        Dim temp As vector(Of String) = Nothing
        strsepar(keyValue, filterKeyValueSep, temp, True)

        If temp.size() <> 2 Then
            raiseError("caught an invalid filter key-value pair " + keyValue, errorHandle.errorType.warning)
            Return False
        Else
            filters(temp(0).ToLower()) = temp(1)
            Return True
        End If
    End Function

    Private Shared Function separateFilters(ByRef key As String _
                                            , ByRef filters As map(Of String, String) _
                                            , ByVal filterMark As String _
                                            , ByVal filterKeyValueSep As String) As Boolean
        If isemptystring(filterMark) Then
            Return True
        End If

        If filters Is Nothing Then
            filters = New map(Of String, String)
        Else
            filters.clear()
        End If

        Dim temp As vector(Of String) = Nothing
        strsepar(key, filterMark, temp, True)
        If temp.size() > 0 Then
            Dim i As Int64
            For i = 1 To temp.size() - 1
                If Not separateFilter(temp(i), filters, filterKeyValueSep) Then
                    raiseError("cannot insert filter " + temp(i), errorHandle.errorType.warning)
                    Return False
                End If
            Next
            key = temp(0)

            Return Not isemptystring(key)
        Else
            raiseError("caught an empty line " + key, errorHandle.errorType.warning)
            Return False
        End If
    End Function

    Private Function separate(ByVal keyValue As String _
                              , ByRef key As String, ByRef value As String _
                              , ByRef environments As [set](Of String) _
                              , ByRef filters As map(Of String, String) _
                              , ByVal separator As String, ByVal environmentMark As String _
                              , ByVal filterMark As String, ByVal filterKeyValueSep As String) As Boolean
        Dim index As Int32
        index = keyValue.IndexOf(separator)
        If index <> npos Then
            key = strleft(keyValue, index)
            value = strmid(keyValue, index + strlen(separator))
        Else
            key = keyValue
            value = emptyString
        End If

        Return separateEnvironments(key, environments, environmentMark) _
                AndAlso separateFilters(key, filters, filterMark, filterKeyValueSep)
    End Function

    Private Function insert(ByVal section As String, ByVal key As String, ByVal value As String _
                            , ByVal matchenv As [set](Of String) _
                            , ByVal filters As map(Of String, String) _
                            , Optional ByVal ignoreenv As Boolean = False _
                            , Optional ByVal bestfilter As Boolean = False) As Boolean
        Dim envmatch As Boolean
        If ignoreenv Then
            envmatch = True
        Else
            envmatch = environmentMatch(matchenv)
        End If

        If envmatch Then
            Dim it As map(Of String, map(Of String, list(Of pair(Of map(Of String, String), String)))).iterator
            Dim work As map(Of String, list(Of pair(Of map(Of String, String), String)))
            it = data.find(section)
            If it = data.end() Then
                it = data.insert(section, New map(Of String, list(Of pair(Of map(Of String, String), String))))
            End If
            work = (+it).second

            If bestfilter Then
                work(key).push_front(make_pair(filters, value))
            Else
                work(key).push_back(make_pair(filters, value))
            End If
            Return True
        Else
            Return True
        End If
    End Function

    Private Function insert(ByVal section As String, ByVal line As String) As Boolean
        If isemptystring(section) Then
            Return False
        Else
            Dim key As String = ""
            Dim value As String = ""
            Dim matchenv As [set](Of String) = Nothing
            Dim filters As map(Of String, String) = Nothing
            If separate(line, key, value, matchenv, filters, separator _
                        , environmentMark, filterMark, filterKeyValueSep) Then
                Return insert(section, key, value, matchenv, filters, False, False)
            Else
                Return False
            End If
        End If
    End Function

    Public Function insert(ByVal section As String, ByVal key As String, ByVal value As String) As Boolean
        Return insert(section, key, value, Nothing, Nothing, True, True)
    End Function

    Public Function registerEnvironment(ByVal env As String) As Boolean
        If Not isemptystring(env) Then
            'curenv.insert(env)
            'curenv.insert(env.ToUpper())
            curenv.insert(env.ToLower())
            Return True
        Else
            Return False
        End If
    End Function

    Public Function registerEnvironments(ByVal envs As vector(Of String)) As Boolean
        If Not envs Is Nothing Then
            Dim i As Int32
            Dim rtn As Boolean = True
            For i = 0 To envs.size() - 1
                rtn = rtn And registerEnvironment(envs(i))
            Next

            Return rtn
        Else
            Return False
        End If
    End Function

    Public Sub registerDefaultEnvironments()
#If Not (PocketPC Or Smartphone) Then
        'this is somehow a stupid design here, application name has no relationship with environment
        'stornode and storoom have affected by this issue, while others are ok,
        'configurations in other applications have no environment with same name as application
        'registerEnvironment(System.Reflection.Assembly.GetExecutingAssembly.GetName.Name)
        registerEnvironment(envs.version())
        registerEnvironment(envs.shortversion())
        registerEnvironment(envs.machinename())
        registerEnvironment(envs.computername())
        registerEnvironment(envs.domainname())
        registerEnvironment(envs.executingDirectory())
        registerEnvironment(envs.build())
        registerEnvironment(envs.runningMode())
#Else
        'registerEnvironment(System.Reflection.Assembly.GetExecutingAssembly.GetName.Name)
        registerEnvironment(Convert.ToString(System.Reflection.Assembly.GetExecutingAssembly.GetName.Version))
#End If
    End Sub

    Public Sub enableFeatures(ByVal s As String)
        If Not isemptystring(s) Then
            Dim feature As String = Nothing
            Dim matchenv As [set](Of String) = Nothing
            If separate(s, feature, Nothing, matchenv, Nothing, separator, environmentMark, Nothing, Nothing) AndAlso _
                environmentMatch(matchenv) Then
                Dim index As Int64
                index = strindexof(feature, featureNameSep, False)
                If index <> npos Then
                    Dim featureName As String = Nothing
                    Dim str As String = Nothing
                    featureName = strleft(feature, index)
                    str = strmid(feature, index + strlen(featureNameSep))
                    Dim v As vector(Of String) = Nothing
                    strsepar(str, featureFilterSep, v, True)
                    'first win
                    If strsame(featureName, featureNaming.stringfilter, False) Then
                        If features.stringFilter Is Nothing Then
                            If Not vector2set(v, features.stringFilter) Then
                                features.stringFilter = New [set](Of String)()
                            End If
                        End If
                    ElseIf strsame(featureName, featureNaming.valueinterval, False) Then
                        If features.valueInterval Is Nothing Then
                            If Not vector2set(v, features.valueInterval) Then
                                features.valueInterval = New [set](Of String)()
                            End If
                        End If
                    ElseIf strsame(featureName, featureNaming.stringserial, False) Then
                        If features.stringSerial Is Nothing Then
                            If Not vector2set(v, features.stringSerial) Then
                                features.stringSerial = New [set](Of String)()
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End Sub

    Public Overridable Function open(ByVal fileName As String) As Boolean
        Dim reader As IO.StreamReader = Nothing
        Dim section As String = ""
        Dim key As String = ""
        Dim value As String = ""
        Dim str As String = ""

#If RETIRED Then
        If Not Path.IsPathRooted(fileName) Then
            _configfile = Path.Combine(System.Environment.CurrentDirectory, fileName)
        Else
            copy(_configfile, fileName)
        End If
#End If
        copy(_configfile, fullpath(fileName))
        'try open file before clear existing configuration to make configMonitor safer
        Try
            reader = New IO.StreamReader(New System.IO.FileStream(fileName, _
                            IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.Read))
        Catch
            Return False
        End Try

        close()
        If curenv.size = 0 Then
            registerDefaultEnvironments()
        End If
        While Not reader.EndOfStream
            str = reader.ReadLine
            kickLeftRightBlank(str)
            Dim index As Int32
            index = strindexof(str, remark)
            While index <> npos
                Dim escape As Boolean
                escape = strsame(str, index - strlen(escapeRemark), escapeRemark, 0, strlen(escapeRemark))
                If Not escape Then
                    str = strleft(str, index)
                    index = npos
                Else
                    strrmv(str, index - strlen(escapeRemark), strlen(escapeRemark))
                    index = strindexof(str, remark, index, 1)
                End If
            End While
            If Not isemptystring(str) Then
                If strsame(str, sectionLeft, strlen(sectionLeft), False) _
                    AndAlso strsame(str, strlen(str) - strlen(sectionRight), sectionRight, 0 _
                                    , strlen(sectionRight), False) Then
                    section = strmid(str, strlen(sectionLeft), _
                                     strlen(str) - strlen(sectionLeft) - strlen(sectionRight))
                    Dim matchenv As [set](Of String) = Nothing
                    If separateEnvironments(section, matchenv, environmentMark) Then
                        If Not environmentMatch(matchenv) Then
                            section = Nothing
                        End If
                    Else
                        raiseError("got invalid section " + str + ", ignore." _
                                   , errorHandle.errorType.warning)
                    End If
                ElseIf Not isemptystring(section) Then 'AndAlso Not insert(section, str) Then
                    'raiseError("got invalid configuration " + str + ", ignore." _
                    ', errorHandle.errorType.warning)
                    insert(section, str)
                Else
                    'no valid section means beforeSection, 20110926
                    'if a configuration line is before every section, define it as a feature of configParser
                    enableFeatures(str)
                End If
            End If
        End While

        closestream(reader)
        Return True
    End Function

    Public Overridable Sub close()
        If data Is Nothing Then
            data = New map(Of String, map(Of String, list(Of pair(Of map(Of String, String), String))))
        Else
            data.clear()
        End If

        If curenv Is Nothing Then
            curenv = New [set](Of String)
        Else
            curenv.clear()
        End If
    End Sub

    Private Function filtersMatch(ByVal inputFilters As map(Of String, String) _
                                  , ByVal configFilters As map(Of String, String)) As Boolean
        If configFilters Is Nothing OrElse configFilters.size() = 0 _
            OrElse inputFilters Is Nothing OrElse inputFilters.size() = 0 Then
            Return True
        End If

        Dim i As map(Of String, String).iterator = Nothing
        i = configFilters.begin()
        While i <> configFilters.end()
            Dim j As map(Of String, String).iterator = Nothing
            j = inputFilters.find((+i).first)
            If j <> inputFilters.end() Then
                Dim rtn As Boolean
                rtn = False
                If features.stringFilterEnabled((+i).first) Then
                    rtn = matchStringFilter((+i).second, (+j).second)
                End If
                If Not rtn AndAlso features.valueIntervalEnabled((+i).first) Then
                    rtn = matchValueInterval((+i).second, (+j).second)
                End If
                If Not rtn AndAlso features.stringSerialEnabled((+i).first) Then
                    rtn = matchStringSerial((+i).second, (+j).second)
                End If
                If Not rtn Then
                    rtn = strsame((+j).second, (+i).second, False)
                End If
                If Not rtn Then
                    Return False
                End If
            Else
                raiseError("caught an invalid filter in configuration " + (+i).first, errorHandle.errorType.warning)
            End If
            i += 1
        End While

        Return True
    End Function

    Private Function getparameter(Of valueT)(ByVal section As String, ByVal key As String, ByRef value As valueT _
                                            , ByVal defaultValue As valueT, ByVal neederrmsg As Boolean) As Boolean
        Return getparameter(section, key, value, defaultValue, Nothing, neederrmsg)
    End Function

    Private Function getparameter(Of valueT)(ByVal values As list(Of pair(Of map(Of String, String), String)) _
                                               , ByRef value As valueT, ByVal defaultValue As valueT _
                                               , ByVal filters As map(Of String, String) _
                                               , ByVal neederrmsg As Boolean) As Boolean
        Dim it As list(Of pair(Of map(Of String, String), String)).iterator = Nothing
        it = values.begin()
        Dim rtn As Boolean = False
        While it <> values.end()
            If filtersMatch(filters, (+it).first) Then
                If convertor.cast(Of valueT)((+it).second, value) Then
                    rtn = True
                End If

                Exit While
            End If
            it += 1
        End While

        If Not rtn Then
            copy(value, defaultValue)
            If neederrmsg Then
                raiseError("do not get configuration for special filters", errorHandle.errorType.warning)
            End If
            Return False
        Else
            Return True
        End If
    End Function

    Private Function getparameter(Of valueT)(ByVal section As String, ByVal key As String, ByRef value As valueT _
                                             , ByVal defaultValue As valueT _
                                             , ByVal filters As map(Of String, String) _
                                             , ByVal neederrmsg As Boolean) As Boolean
        Dim it As map(Of String, map(Of String, list(Of pair(Of map(Of String, String), String)))).iterator
        copy(value, defaultValue)
        it = data.find(section)
        If it = data.end() Then
            If neederrmsg Then
                raiseError("no section found in configuration " + configfile() + ", section = " + section + _
                            ", key = " + key + ", will use default value [" _
                            + Convert.ToString(defaultValue) + "] if available", _
                            errorHandle.errorType.warning)
            End If
            Return False
        Else
            Dim it2 As map(Of String, list(Of pair(Of map(Of String, String), String))).iterator
            it2 = (+it).second.find(key)
            If it2 = (+it).second.end() Then
                If neederrmsg Then
                    raiseError("no key found in configuration " + configfile() + ", section = " + section + _
                                ", key = " + key + ", will use default value [" _
                                + Convert.ToString(defaultValue) + "] if available", _
                                errorHandle.errorType.warning)
                End If
                Return False
            Else
                Return getparameter((+it2).second, value, defaultValue, filters, neederrmsg)
            End If
        End If
    End Function

    Public Function getparameter(Of valueT)(ByVal section As String, ByVal key As String, ByRef value As valueT _
                                            , ByVal defaultValue As valueT) As Boolean
        Return getparameter(section, key, value, defaultValue, True)
    End Function

    Public Function trygetparameter(Of valueT)(ByVal section As String, ByVal key As String, ByRef value As valueT _
                                               , ByVal defaultValue As valueT) As Boolean
        Return getparameter(section, key, value, defaultValue, False)
    End Function

    Public Function getparameter(Of valueT)(ByVal section As String, ByVal key As String, ByRef value As valueT _
                                            , ByVal defaultValue As valueT _
                                            , ByVal filters As map(Of String, String)) As Boolean
        Return getparameter(section, key, value, defaultValue, filters, True)
    End Function

    Public Function trygetparameter(Of valueT)(ByVal section As String, ByVal key As String, ByRef value As valueT _
                                               , ByVal defaultValue As valueT _
                                               , ByVal filters As map(Of String, String)) As Boolean
        Return getparameter(section, key, value, defaultValue, filters, False)
    End Function

    Public Function getparameter(Of valueT)(ByVal section As String, ByVal key As String _
                                            , ByRef value As valueT) As Boolean
        Dim defaultValue As valueT = Nothing
        Return getparameter(section, key, value, defaultValue)
    End Function

    Public Function getparameter(Of valueT)(ByVal section As String, ByVal key As String _
                                            , ByRef value As valueT, ByVal filters As map(Of String, String)) As Boolean
        Dim defaultValue As valueT = Nothing
        Return getparameter(section, key, value, defaultValue, filters)
    End Function

    Public Function parameter(Of valueT)(ByVal section As String, ByVal key As String _
                                         , ByVal defaultValue As valueT) As valueT
        Dim rtn As valueT = Nothing
        getparameter(section, key, rtn, defaultValue)
        Return rtn
    End Function

    Public Function parameter(Of valueT)(ByVal section As String, ByVal key As String _
                                         , ByVal defaultValue As valueT _
                                         , ByVal filters As map(Of String, String)) As valueT
        Dim rtn As valueT = Nothing
        getparameter(section, key, rtn, defaultValue, filters)
        Return rtn
    End Function

    Public Function parameter(Of valueT)(ByVal section As String, ByVal key As String) As valueT
        Dim rtn As valueT = Nothing
        getparameter(section, key, rtn)
        Return rtn
    End Function

    Public Function parameter(Of valueT)(ByVal section As String, ByVal key As String _
                                         , ByVal filters As map(Of String, String)) As valueT
        Dim rtn As valueT = Nothing
        getparameter(section, key, rtn, filters)
        Return rtn
    End Function

    Public Function readlist(Of valueT)(ByVal section As String, ByVal key As String _
                                        , ByRef values As vector(Of valueT)) As Boolean
        Return readlist(section, key, values, Nothing)
    End Function

    Public Function readlist(Of valueT)(ByVal section As String, ByVal key As String _
                                        , ByRef values As vector(Of valueT) _
                                        , ByVal filters As map(Of String, String)) As Boolean
        If values Is Nothing Then
            values = New vector(Of valueT)()
        Else
            values.clear()
        End If
        Dim i As Int32 = 0
        Dim value As valueT = Nothing
        Dim defaultValue As valueT = Nothing
        While getparameter(section, key + Convert.ToString(i), value, defaultValue, filters, False)
            values.push_back(value)
            i += 1
        End While

        If values.size() = 0 Then
            If getparameter(section, key, value, defaultValue, filters, False) Then
                values.push_back(value)
                Return True
            Else
                Return False
            End If
        Else
            Return True
        End If
    End Function

    Public Function existSection(ByVal sectionName As String) As Boolean
        Return Not section(sectionName) Is Nothing
    End Function

    Public Function existParameter(ByVal section As String, ByVal key As String) As Boolean
        Dim it As map(Of String, map(Of String, list(Of pair(Of map(Of String, String), String)))).iterator = Nothing
        it = data.find(section)
        If it = data.end() Then
            Return False
        Else
            Return (+it).second.find(key) <> (+it).second.end()
        End If
    End Function

    Public Function section(ByVal sectionName As String) _
                            As map(Of String, list(Of pair(Of map(Of String, String), String)))
        Dim it As map(Of String, map(Of String, list(Of pair(Of map(Of String, String), String)))).iterator = Nothing
        it = data.find(sectionName)
        If it = data.end() Then
            Return Nothing
        Else
            Return (+it).second
        End If
    End Function

    Public Function section(ByVal sectionName As String, ByVal filters As map(Of String, String)) _
                            As sortmap(Of String, String)
        Dim sectionall As map(Of String, list(Of pair(Of map(Of String, String), String))) = Nothing
        sectionall = section(sectionName)
        If Not sectionall Is Nothing AndAlso sectionall.size() > 0 Then
            Dim it As map(Of String, list(Of pair(Of map(Of String, String), String))).iterator = Nothing
            Dim rtn As sortmap(Of String, String) = Nothing
            rtn = New sortmap(Of String, String)()
            it = sectionall.begin()
            While it <> sectionall.end()
                Dim value As String = Nothing
                If getparameter((+it).second, value, Nothing, filters, False) Then
                    rtn((+it).first) = value
                End If
                it += 1
            End While

            If rtn.size() = 0 Then
                Return Nothing
            Else
                Return rtn
            End If
        Else
            Return Nothing
        End If
    End Function

    Public Shared Operator +(ByVal this As configParser) _
                            As map(Of String, map(Of String, list(Of pair(Of map(Of String, String), String))))
        Return this.data
    End Operator

    Private Sub initial()
        features = New featuresDef()
    End Sub

    Public Sub New()
        initial()
    End Sub

    Public Sub New(ByVal fileName As String)
        initial()
        open(fileName)
    End Sub

    Public Shared Sub unittest()
        Const configfile As String = "config.ini"
        Dim config As configParser
        config = New configParser
        config.open(configfile)
    End Sub
End Class
